#
# Routines to send email on behalf of the Linux Counter
# This is the i18n version...
#
package Counter::Sendemail;

use strict;
use Counter;
use MD5Cookies;
use Socket;
use POSIX qw(strftime uname setlocale);
use Locale::gettext 1.04;

use vars qw($test $shortfrom $DEBUG %messages);

$test = 0;
$shortfrom = "errors\@counter.li.org";

# Possible messages.
$messages{normal} = <<'EoF';
You are registered as user #\$key with the Linux Counter, http://counter.li.org.
The data stored about you is given below.
To update your record, go to http://counter.li.org/person/ and enter your userid and password.

Your userid is $key.
Your password is $password.

Or click the following link (valid for a week after receiving this email):

http://counter.li.org/renew.php?id=$identification

You should log in at least once a year in order to keep your entry from being deleted from the counter.

If you want to help advertise Linux - point your friends to
http://counter.li.org/!

COMMON PROBLEMS:
----------------
If you have removed your info, there is very little below. The counter has noted that you own this email, and will prevent others from registering it (by requiring the key). Do not worry - this info is not public.

If you get two messages with different user numbers - drop a line to help\@counter.li.org, giving the two registration numbers, and request that they be merged. 
Remember to state which address you want the counter to send email to!

Any other problems - mail help\@counter.li.org!

Have fun, enjoy Linux!
EoF

$messages{frozen} = <<'EoF';
You used to be registered with the Linux Counter at
http://counter.li.org/ as user #$key.
Our records show that you have not updated this entry for a long time. In order to make sure the published Linux Counter data is accurate, we have removed your entry from the published counts.
*******************************************************************
Your entry has been removed from the counter and placed on backing store. You are not counted as a Linux user.
To restore your entry, go to http://counter.li.org/person/ and log in with the following details:

    User: $key
    Password: $password

or click the following link (valid for a week after receiving this email):

    http://counter.li.org/renew.php?id=$identification

If you choose not to do this, this message should be the last ever sent to you from the Linux Counter.
*******************************************************************
EoF

$messages{test} = "send18mail not translated";


# Dump the texts from the message table in a form suitable for xgettext
sub dumptexts {
    for my $key (keys(%messages)) {
	my $msg = $messages{$key};
	$msg =~ s/\n/\\n/g;
	print "_(\"" . $msg . "\")\n";
    }
}

# Language initialization: Should be another module.
# Copied from CounterCGI.pm

sub set_language_environment {
    my $language = shift;

    if ($language eq "") {
        $language = "en_US";
    }
    $ENV{LANGUAGE} = $language;
    setlocale(LC_ALL, $language);
    setlocale(LC_NUMERIC, "en_US");
    warn "messages is ", $ENV{COUNTER_ROOT}, "/i18n/translations/locale\n";
    bindtextdomain("messages", $ENV{COUNTER_ROOT} . "/i18n/translations/locale");
    textdomain("messages");
    # note: this works only with a patched Locale::gettext 1.03...
    Locale::gettext::bind_textdomain_codeset("messages", "utf-8");
    my $testvar = __($messages{test});
    if ($testvar eq $messages{test}) {
	warn "Not translated: $language\n";
    }
}

sub language_to_locale {
    my $language = shift;
    my %languages = (
		     "nl" => "nl_NL",
		     "NL" => "nl_NL",
		     "en" => "en_US",
		     "fi" => "fi_FI",
		     "fr" => "fr_FR",
		     "hu" => "hu_HU",
		     "it" => "it_IT",
		     "de" => "de_DE",
		     "no" => "no_NO",
		     "ro" => "ro_RO",
		     "ru" => "ru_RU",
		     "sr" => "sr_YU",
		     );
    if ($languages{$language}) {
	return $languages{$language};
    } else {
	warn "$language unknown - returning a hack\n";
	return "\L${language}_\U$language";
    }
}

# gettext abbreviation
sub __ {gettext(@_)}

sub test {
    my $newval = shift;
    if (defined($newval)) {
	my $retval = $test;
	$test = $newval;
	return $retval;
    } else {
	return $test;
    }
}

sub sendemail {

    my $key = shift;
    my $message = shift;
    my $users = Counter::openfile("users");
    my $user = $users->get($key);

# Create a from addr that includes the record. Nice for bounce processing
    my $fromaddr = "errors+$key\@counter.li.org";

    if (!$user) {
	die "No user record for key $key\n";
    }
    if ($user->{state} eq "blocked") {
	die "User $key is in blocked state\n";
    }


    my $language = $user->language();
    $DEBUG && warn "Language is $language\n";
    set_language_environment(language_to_locale($language));
    # Find if we have language specific file
    my $msgdir = Counter::root() . "/i18n/email";
    $DEBUG && warn "Msgdir is $msgdir\n";

    if (!$message) {

	if ($user->{state} ne "frozen") {
	    $message = $messages{normal};
	} else {
	    $message = $messages{frozen};
	}
	my $msgtrans = __($message);
	if ($msgtrans ne $message) { # translated
	    $message = $msgtrans . "\n\n--------- English ----------\n"
		. $message;
	} elsif ($language ne "en" && $language ne "i-default") {
	    $message = "[I am sorry, but this text is not available in language \"$language\" yet]\n\n" . $message;
	}
    }	    


# Create the identification id for the renew url in the email
my $id = MD5Cookies::tsign($key, $$user{key}, 7*24*60*60);
# warn "output: $id";

# Put data from user record into message
    $message =~ s/\$key\b/$key/g;
    $message =~ s/\$password\b/$$user{key}/g;
    $message =~ s/\$identification\b/$id/g;

# Get the addresses to send to. Command line overrides record.
    my @sendto;
    while (my $addr = shift) {
	push(@sendto, detaintaddr($addr));
    } 
    if (!defined($sendto[0])) {
	$sendto[0] = detaintaddr($user->{email});
    }

# Detaint from, "just in case"
    $fromaddr = detaintaddr($fromaddr);

# Check if I am the Linux Counter
    if (!$test && !isrealcounter()) {
	warn "I am not the Linux Counter - not sending mail for $key to ",
	join(" ", @sendto), "\n";
	if (-t STDERR) {
	    warn "Switching into test mode\n";
	    $test = 1;
	} else {
	    return;
	}
    }

    my $sendto = quoteshellmeta(join(" ", @sendto));
    if ($test) {
	warn "Starting to send mail\n";
	open(MAIL, ">&STDOUT");
	print "CMD: |/usr/lib/sendmail -f$fromaddr -- ", $sendto, "\n";
    } else {
	# note redirect of stdout of sendmail to stderr = error log file
	open(MAIL, "|/usr/lib/sendmail -f$fromaddr -- $sendto > /dev/null 1>&2");
    }

# If sendto is multiple addresses, take care

    $sendto = join(", ", @sendto);
    
    print MAIL "From: Linux Counter <$shortfrom>\n";
    print MAIL "To: $sendto\n";
    print MAIL "Subject: " . __("Your entry in the Linux Counter") . "\n";
    print MAIL "Content-type: text/plain; charset=utf-8\n";
    print MAIL "\n";
    print MAIL $message;

    print MAIL __("All comments:") . "help\@counter.li.org\n";


    my $persons = Counter::openfile("persons");
    my $person = $persons->get($key);

    print MAIL __("Your record was created: "), " $$user{f_ctime}\n";
    if ($person) {
	print MAIL "Person info last modified: $$person{f_mtime}\n";
    }
    print MAIL "\n";

    print MAIL "//KEY ", $user->{key}, "\n";
    print MAIL "# The key is your password to update info in the counter\n";

    print MAIL "//REPLYTO ", $user->{email}, "\n";
    print MAIL "# Your registered email for messages from the counter", "\n";
    print MAIL "# This email is NOT visible to other people\n";

    if ($person) {
	print MAIL "\n//PERSON\n";
	my $clean = $persons->getclean($key);
	for my $field ($persons->fields) {
	    emitfield($person, $clean, $field);
	}
    }
    my $machines = Counter::openfile("machines");
    for my $machine ($machines->select("owner=?", $key)) {
	my $clean = $machines->getclean($machine->key);
	print MAIL "\n//MACHINE ", $machine->key, "\n";
	for my $field ($machines->fields) {
	    emitfield($machine, $clean, $field);
	}
    }
    close MAIL;
    $user->{emailtime} = strftime "%Y-%m-%d %H:%M:%S", gmtime();
    $user->store() if !$test;

}

sub emitfield {
    my ($rec, $clean, $field) = @_;
    print MAIL "$field: ", $rec->{$field}, "\n";
    if ("\L$clean->{$field}" ne "\L$rec->{$field}") {
	if ($clean->{$field} !~ /^\s*$/) {
	    print MAIL "# Interpreted as ", $clean->{$field}, "\n";
	} else {
	    print MAIL "# Interpreted as empty field (comment)\n";
	}
    }
}

# This will do until a better hack comes along....
sub isrealcounter {
    my $counter = gethostbyname("counter.li.org");
    my ($sys, $node, $rel, $ver, $mach) = uname();
    my $me = gethostbyname($node);
    die "Bad me" if length($me) < 4;
    die "Bad counter" if length($counter) < 4;
    if ($me ne $counter) {
	warn "I am ", inet_ntoa($me), ", not ", inet_ntoa($counter), "\n";
	return 0;
    } else {
	return 1;
    }
}

# Guardian routine against obvious problems with command-line args
sub detaintaddr {
    my $addr = shift;

    # Strip spaces
    $addr =~ s/^\s+//;
    $addr =~ s/\s+$//;
    # Check for user@host format
    if ($addr =~ /^(\S+)\@(\S+)$/) {
	$addr = "$1\@$2";
    } elsif  ($addr =~ /^"([^" ]+) ([^" ]+")@\S+/) {
	# allow a single quoted space in an address 
	warn "Quoted address: $addr\n";
	$addr = "$&";
    } else {
	die "Bogus shape of addr: $addr\n";
    }
    # Scan for shell metacharacters, or leading dash (sendmail option)
    # leading dash defeated by adding -- to sendmail command line.
    if ($addr =~ /[|;*?\(\)]/) {
	# be conservative - allow as needed
	# at the moment, asterisk is allowed
	if ($addr =~ /[|;?\(\)]/ || $addr =~ /^-/) {
	    die "Bogus char in addr: $addr\n";
	} else {
	    warn "Shell metachar in addr - to be quoted: $addr\n";
	}
    }
    $addr;
}

sub quoteshellmeta {
    my $addr = shift;
    my $oldaddr = $addr;
    $addr =~ s/[|;*?\(\)']/\\$&/g; # ';
    # allow a single quoted space in an address 
    $addr =~ s/"([^" ]+) ([^" ]+)"@/\\"$1\\ $2\\"@/; #";
    if ($oldaddr ne $addr) {
	warn "Quoted shell argument to $addr\n";
    }
    $addr;
}

sub readfile {
    my $filename = shift;

    $DEBUG && warn "Reading $filename\n";
    open(MSG, $filename) || die "Unable to open file $filename\n";
    local $/;
    my $content = <MSG>;
    close MSG;
    return $content;
}
